home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1998 January / Macworld (1998-01).dmg / Shareware World / Comms & Internet / HTML mode 2.0 etc. / installScript.tcl < prev    next >
Encoding:
Text File  |  1997-08-17  |  11.1 KB  |  340 lines  |  [TEXT/ALFA]
  1. #===============================================================================
  2. #
  3. # installScript.tcl
  4. #
  5. # This file is used for installing HTML mode, CSS mode, JavaScript mode and Frontier menu.
  6. # 
  7. # See the file READ ME TO INSTALL.
  8. # 
  9. # Author: Johan Linde
  10. #
  11. #===============================================================================
  12.  
  13.  
  14. # Find which version of HTML mode is in folder.
  15. proc htmlGetHtmlVersion {folder} {
  16.     if {![file exists $folder:html.tcl]} {return "none"}
  17.     set cid [scancontext create]
  18.     set fid [open $folder:html.tcl]
  19.     
  20.     scanmatch $cid "editing HTML documents" {
  21.         regexp {HTML mode ([^:]+)} $matchInfo(line) dum version
  22.     }
  23.     
  24.     scanfile $cid $fid
  25.     close $fid
  26.     scancontext delete $cid
  27.     if {[info exists version]} {return [string trim $version]}
  28.     return "unknown"
  29. }
  30.  
  31. # Find which version of object is in folder.
  32. proc htmlGetVersion {folder object} {
  33.     if {$object == "htmlMode"} {return [htmlGetHtmlVersion $folder]}
  34.     if {![file exists $folder:$object.tcl]} {return "none"}
  35.     set cid [scancontext create]
  36.     set fid [open $folder:$object.tcl]
  37.     
  38.     scanmatch $cid "Version:" {
  39.         regexp {Version:(.*)} $matchInfo(line) dum version
  40.     }
  41.     
  42.     scanfile $cid $fid
  43.     close $fid
  44.     scancontext delete $cid
  45.     if {[info exists version]} {return [string trim $version]}
  46.     return "unknown"
  47. }
  48.  
  49. proc htmlModeFileList {version} {
  50.     switch -glob $version {
  51.         1.1beta {set files {html.tcl htmlElems.tcl htmlEngine.tcl htmlLevels.tcl htmlMode.tcl}}
  52.         1.1 {set files {html.tcl htmlElems.tcl htmlEngine.tcl htmlLevels.tcl htmlMode.tcl}}
  53.         1.1.1 {set files {html.tcl htmlElems.tcl htmlEngine.tcl htmlExtra.tcl htmlLevels.tcl htmlMode.tcl}}
  54.         1.2* {set files {html.tcl htmlCustom.tcl htmlElems.tcl htmlEngine.tcl htmlExtra.tcl htmlMenu.tcl htmlMode.tcl}}
  55.         1.3* {set files {html.tcl htmlCustom.tcl htmlElems.tcl htmlEngine.tcl htmlExtra.tcl htmlMenu.tcl htmlMode.tcl htmlUtils.tcl}}
  56.         1.4* {set files {html.tcl htmlCustom.tcl htmlElems.tcl htmlEngine.tcl htmlExtra.tcl htmlMenu.tcl htmlMode.tcl htmlUtils.tcl}}
  57.         2.0* {set files {cssMode.tcl hctsmsl.tcl hctsmslMenu.tcl hctsmslShared.tcl html.tcl html32.tcl 
  58.         htmlCustom.tcl htmlElems.tcl htmlEngine.tcl htmlExtensions.tcl htmlHomePageUtils.tcl htmlMenu.tcl htmlMode.tcl htmlStatusBar.tcl htmlUtils.tcl}}
  59.         default {set files {html.tcl htmlMode.tcl}}
  60.     }
  61.     return $files
  62. }
  63.  
  64. proc javaScriptModeFileList {version} {
  65.     return javaScriptMode.tcl
  66. }
  67.  
  68. proc frontierMenuFileList {version} {
  69.     return
  70. }
  71.  
  72. proc htmlModeHelpFiles {version} {
  73.     return {"HTML Help"}
  74. }
  75.  
  76. proc javaScriptModeHelpFiles {version} {
  77.     return
  78. }
  79.  
  80. proc frontierMenuHelpFiles {version} {
  81.     return {"Frontier Help"}
  82. }
  83.  
  84. proc htmlModeMenuFiles {version} {
  85.     return
  86. }
  87.  
  88. proc javaScriptModeMenuFiles {version} {
  89.     return
  90. }
  91.  
  92. proc frontierMenuMenuFiles {version} {
  93.     return frontierMenu.tcl
  94. }
  95.  
  96. proc htmlBackupObject {version object installFolder} {
  97.     global HOME PREFS
  98.     set text(htmlMode) "HTML mode"
  99.     set text(javaScriptMode) "JavaScript mode"
  100.     set text(frontierMenu) "Frontier menu"
  101.     if {[file exists "$HOME:$text($object) $version backup"]} {
  102.         set i 1
  103.         while {[file exists "$HOME:$text($object) $version backup.$i"]} {
  104.             incr i
  105.         }
  106.         mkdir [set folder "$HOME:$text($object) $version backup.$i"]
  107.     } else {
  108.         mkdir [set folder "$HOME:$text($object) $version backup"]
  109.     }
  110.     copyFile "$installFolder:installScript.tcl" "$folder:installScript.tcl"
  111.     copyFile "$installFolder:READ ME TO INSTALL" "$folder:READ ME TO INSTALL"
  112.     foreach fil [eval ${object}FileList $version] {
  113.         if {[file exists "$HOME:Tcl:Modes:$fil"]} {
  114.             copyFile "$HOME:Tcl:Modes:$fil" "$folder:$fil"
  115.         } else {
  116.             lappend missing $fil
  117.         }
  118.     }
  119.     foreach fil [eval ${object}HelpFiles $version] {
  120.         if {[file exists "$HOME:Help:$fil"]} {
  121.             copyFile "$HOME:Help:$fil" "$folder:$fil"
  122.         } else {
  123.             lappend missing $fil
  124.         }
  125.     }
  126.     foreach fil [eval ${object}MenuFiles $version] {
  127.         if {[file exists "$HOME:Tcl:Menus:$fil"]} {
  128.             copyFile "$HOME:Tcl:Menus:$fil" "$folder:$fil"
  129.         } else {
  130.             lappend missing $fil
  131.         }
  132.     }
  133.     if {$object == "htmlMode" && [file exists "$PREFS:HTMLadditions.tcl"]} {copyFile "$PREFS:HTMLadditions.tcl" "$folder:HTMLadditions.tcl"}
  134.     if {[info exists missing] && [lindex [dialog -w 250 -h 200 \
  135.         -t "The old files $missing are missing.\rBackup of $text($object) is inscomplete. Continue installation of $text($object)?" 10 10 240 160 \
  136.         -b Continue 20 170 85 190 -b Cancel 105 170 170 190] 1]} {
  137.         error "Abort installation."
  138.     }
  139. }
  140.  
  141. proc htmlRemoveObject {version object} {
  142.     global HOME
  143.     foreach fil [eval ${object}FileList $version] {
  144.         if {[file exists "$HOME:Tcl:Modes:$fil"]} {
  145.             removeFile "$HOME:Tcl:Modes:$fil"
  146.         }
  147.     }
  148.     foreach fil [eval ${object}HelpFiles $version] {
  149.         if {[file exists "$HOME:Help:$fil"]} {
  150.             removeFile "$HOME:Help:$fil"
  151.         }
  152.     }
  153.     foreach fil [eval ${object}MenuFiles $version] {
  154.         if {[file exists "$HOME:Tcl:Menus:$fil"]} {
  155.             removeFile "$HOME:Tcl:Menus:$fil"
  156.         }
  157.     }
  158. }
  159.  
  160. proc htmlExtraBackup {fil} {
  161.     global HOME
  162.     set backup "$HOME:Extra backup"
  163.     if {[file exists $backup] && ![file isdirectory $backup]} {
  164.         set i 1
  165.         while {[file exists $backup.$i] && ![file isdirectory $backup]} {incr i}
  166.         set backup $backup.$i
  167.     }
  168.     if {![file exists "$backup"]} {mkdir "$backup"}
  169.     set newfile "$backup:[file tail $fil]"
  170.     if {[file exists $newfile]} {
  171.         set i 1
  172.         while {[file exists $newfile.$i]} {incr i}
  173.         set newfile "$newfile.$i"
  174.     }
  175.     copyFile $fil $newfile
  176.     removeFile $fil
  177. }
  178.  
  179.     
  180. proc htmlInstallObject {version object installFolder} {
  181.     global HOME PREFS
  182.     foreach fil [eval ${object}FileList $version] {
  183.         if {[file exists "$HOME:Tcl:Modes:$fil"]} {htmlExtraBackup "$HOME:Tcl:Modes:$fil"}
  184.         copyFile "$installFolder:$fil" "$HOME:Tcl:Modes:$fil"
  185.     }
  186.     foreach fil [eval ${object}HelpFiles $version] {
  187.         if {[file exists "$HOME:Help:$fil"]} {htmlExtraBackup "$HOME:Help:$fil"}
  188.         copyFile "$installFolder:$fil" "$HOME:Help:$fil"
  189.     }
  190.     foreach fil [eval ${object}MenuFiles $version] {
  191.         if {[file exists "$HOME:Tcl:Menus:$fil"]} {htmlExtraBackup "$HOME:Tcl:Menus:$fil"}
  192.         copyFile "$installFolder:$fil" "$HOME:Tcl:Menus:$fil"
  193.     }
  194.     if {$object == "htmlMode" && [string index $version 0] == "2"} {
  195.         catch {removeFile "$HOME:Tcl:Modes:htmlLevels.tcl"}
  196.         catch {removeFile "$HOME:Tcl:Modes:htmlExtra.tcl"}
  197.     }
  198.     if {$object == "htmlMode" && [file exists "$installFolder:HTMLadditions.tcl"]} {
  199.         catch {removeFile "$PREFS:HTMLadditions.tcl"}
  200.         copyFile "$installFolder:HTMLadditions.tcl" "$PREFS:HTMLadditions.tcl"
  201.     }
  202. }
  203.  
  204. proc HTMLmodeInstaller {installFolder} {
  205.     global HOME PREFS
  206.  
  207.     set text(htmlMode) "HTML mode"
  208.     set text(javaScriptMode) "JavaScript mode"
  209.     set text(frontierMenu) "Frontier menu"
  210.     set maxVers(htmlMode) {^1\.|^2\.0}
  211.     set maxVers(javaScriptMode) {^1\.0}
  212.     set maxVers(frontierMenu) {^1\.|^2\.0}
  213.     
  214.     set minVers 6.2
  215.     # Build a dialog
  216.     set box "-t {Select what to install and what to backup} 50 10 350 30"
  217.     set h 50
  218.     foreach object {htmlMode javaScriptMode frontierMenu} {
  219.         set $object 1
  220.         set vers [htmlGetVersion $installFolder $object]
  221.         if {$vers == "none"} {
  222.             set $object 0
  223.             continue
  224.         }
  225.         if {$vers == "unknown"} {
  226.             alertnote "Could not find out which version of $text($object) there is in this folder. Can't install."
  227.             set $object 0
  228.             continue
  229.         }
  230.         if {![regexp $maxVers($object) $vers]} {
  231.             # Version to install is too new for this script.
  232.             alertnote "Sorry, don't know how to install $text($object) $vers."
  233.             continue
  234.         }
  235.         if {$object == "htmlMode" && [string index $vers 0] == "2"} {
  236.             set cssVers [htmlGetVersion $installFolder cssMode]
  237.             if {$cssVers == "none"} {
  238.                 set $object 0
  239.                 continue
  240.             }
  241.             if {$cssVers == "unknown"} {
  242.                 alertnote "Could not find out which version of CSS mode there is in this folder. Can't install."
  243.                 set $object 0
  244.                 continue
  245.             }            
  246.         }
  247.         set currFolder $HOME:Tcl:Modes
  248.         if {$object == "frontierMenu"} {set currFolder $HOME:Tcl:Menus}
  249.         set currVers [htmlGetVersion $currFolder $object]
  250.         if {$currVers != "none" && $currVers != "unknown" && ![regexp $maxVers($object) $currVers]} {
  251.             # Current version is to new for this script.
  252.             alertnote "$text($object) $currVers is installed. Can't replace it by $text($object) $vers."
  253.             continue
  254.         }
  255.         # Check that all files to install exist.
  256.         set allfound 1
  257.         foreach fil [concat [eval ${object}FileList vers] [eval ${object}HelpFiles $vers] [eval ${object}MenuFiles $vers]] {
  258.             if {![file exists "$installFolder:$fil"]} {
  259.                 alertnote "The file $fil is missing. Can't install $object($text)."
  260.                 set allfound 0
  261.                 break
  262.             }
  263.         }
  264.         if {!$allfound} {continue}
  265.         
  266.         set modetext "$text($object) $vers"
  267.         if {$object == "htmlMode" && [string index $vers 0] == "2"} {
  268.             append modetext " and CSS mode $cssVers"
  269.             set minVers 6.51
  270.         }
  271.         append box " -c [list $modetext] [expr (\"$vers\" != \"$currVers\")] 10 $h 350 [expr $h + 25]"
  272.         incr h 20
  273.         if {$object == "htmlMode" && [string index $currVers 0] == "2"} {set currCSS [htmlGetVersion $currFolder cssMode]}
  274.         set currtext "Currently installed: $currVers"
  275.         set backup$object 1
  276.         if {$currVers == "none"} {set backup$object 0}
  277.         if {$currVers == "unknown"} {set backup$object 0}
  278.         if {$object == "htmlMode" && [string index $currVers 0] == "2"} {append currtext " and $currCSS"}
  279.         append box " -t [list $currtext] 10 $h 350 [expr $h + 15]"
  280.         incr h 20
  281.         if {[set backup$object]} {append box " -c {Make backup before installing} [expr (\"$vers\" != \"$currVers\")] 30 $h 350 [expr $h + 15]"; incr h 20}
  282.         incr h 10
  283.         set new$object $vers
  284.         set curr$object $currVers
  285.     }
  286.     
  287.     if {!$htmlMode && !$javaScriptMode && !$frontierMenu} {
  288.         alertnote "Found nothing to install."
  289.     }
  290.     # Check that Alpha is recent enough.
  291.     regexp {([0-9]+\.[0-9]+)[ab]?([0-9]*)} [version] dum Avers versbeta
  292.     if {$Avers < $minVers || ($Avers == $minVers && $versbeta != "")} {
  293.         alertnote "You need Alpha $minVers or later."
  294.         return
  295.     }
  296.     # Ask what to install.
  297.     set values [eval [concat dialog -w 360 -h [expr $h + 30] -b Install 20 $h 85 [expr $h + 20] \
  298.         -b Cancel 115 $h 180 [expr $h + 20] $box]]
  299.     
  300.     if {[lindex $values 1]} {return}
  301.     
  302.     # Make backups.
  303.     set i 1
  304.     foreach object {htmlMode javaScriptMode frontierMenu} {
  305.         if {![set $object]} {continue}
  306.         incr i
  307.         if {![set backup$object]} {continue}
  308.         incr i
  309.         if {![lindex $values [expr $i - 1]] || ![lindex $values $i]} {continue}
  310.         message "Making backup of $text($object) [set curr$object]…"
  311.         if {[catch {htmlBackupObject [set curr$object] $object $installFolder}]} {
  312.             alertnote "Making backup failed. Installation cancelled. No files have been deleted."
  313.             return
  314.         }
  315.     }
  316.     # Make installations
  317.     set installSomething 0
  318.     set i 1
  319.     foreach object {htmlMode javaScriptMode frontierMenu} {
  320.         if {![set $object]} {continue}
  321.         incr i
  322.         if {![lindex $values $i]} {
  323.             if {[set backup$object]} {incr i}
  324.             continue
  325.         }
  326.         if {[set backup$object]} {incr i}
  327.         set installSomething 1
  328.         message "Installing $text($object) [set new$object]…"
  329.         if {([set backup$object] && [catch {htmlRemoveObject [set curr$object] $object}]) || [catch {htmlInstallObject [set new$object] $object  $installFolder}]} {
  330.             alertnote "Installation failed. Some of the old files may have been removed. Use the backup to reinstall the old version or try installing again."
  331.             return
  332.         }
  333.     }
  334.     if {!$installSomething} {alertnote "Nothing was installed."; return}
  335.     rebuildTclIndices
  336.     if {[lindex [dialog -w 300 -h 100 -t "Installation was successful. You must now restart Alpha." 10 10 290 50 \
  337.         -b Quit 20 70 85 90 -b Cancel 105 70 170 90] 0]} {quit}
  338. }
  339.  
  340.